home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / modula.arc / LIST.MOD < prev    next >
Text File  |  1985-05-30  |  2KB  |  67 lines

  1. (* A procedure "search" is to locate records with a given key
  2.    in an ordered list.  If the key is not present, then a new
  3.    record is to be inserted so that the ordering of keys is
  4.    maintained.  Use a sentinel at the end of the list. *)
  5.  
  6. MODULE list;
  7.  
  8. FROM InOut   IMPORT Write, WriteLn, WriteString, ReadCard, WriteCard;
  9. FROM Storage IMPORT ALLOCATE;
  10.  
  11. TYPE ref = POINTER TO word;
  12.      word = RECORD
  13.               key: CARDINAL;
  14.               count:CARDINAL;
  15.               next: ref
  16.             END;
  17.  
  18. VAR k: CARDINAL;
  19.     root,sentinel: ref;
  20.  
  21. PROCEDURE search(x: CARDINAL; VAR root: ref);
  22. VAR w1,w2,w3: ref;
  23.  
  24. BEGIN
  25.   w2 := root;
  26.   w1 := w2^.next;
  27.   sentinel^.key := x;
  28.   WHILE w1^.key < x DO
  29.     w2 := w1;
  30.     w1 := w2^.next
  31.   END;
  32.   IF (w1^.key = x) AND (w1 # sentinel) THEN
  33.     INC(w1^.count);
  34.   ELSE
  35.     NEW(w3);  (* insert w3 between w1 and w2 *)
  36.     WITH w3^ DO
  37.       key := x;
  38.       count := 1;
  39.       next := w1
  40.     END;
  41.     w2^.next := w3
  42.   END
  43. END search;
  44.  
  45. PROCEDURE printlist(w,z: ref);
  46. BEGIN
  47.   WriteString('     Key   Count');
  48.   WriteLn;
  49.   WHILE w # z DO
  50.     WriteCard(w^.key,6);
  51.     WriteCard(w^.count,6);
  52.     w := w^.next; WriteLn
  53.   END
  54. END printlist;
  55.  
  56. BEGIN
  57.   NEW(root); NEW(sentinel);
  58.   root^.next := sentinel;
  59.   LOOP
  60.     WriteString(' Enter k> ');
  61.     ReadCard(k); WriteLn;
  62.     IF k = 0 THEN EXIT END;
  63.     search(k,root);
  64.   END;
  65.   printlist(root^.next,sentinel)
  66. END list.
  67.